PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/vb/syswtch.exe/PLANS.BAS

BASIC Source File | 1991-11-14 | 5.3 KB | 190 lines

DefInt A-Z

Sub Frame (F As Form, L, T, H, W)
  F.DrawWidth = 1
  F.forecolor = &HE0E0E0
  'bottom:
F.Line (L + F.DrawWidth, T + H + OffSet)-(L + W - F.DrawWidth, T + H + OffSet)

  'right:
F.Line (L + W + OffSet, T + F.DrawWidth)-(L + W + OffSet, T + H + OffSet - F.DrawWidth)

F.forecolor = &H808080
  'top:
 F.Line (L - BigOffSet + F.DrawWidth, T - BigOffSet)-(L + W + BigOffSet - F.DrawWidth, T - BigOffSet)

  'left:
F.Line (L - BigOffSet, T + F.DrawWidth - BigOffSet)-(L - BigOffSet, T + H + BigOffSet - F.DrawWidth)

End Sub

Sub Frame2 (F As Form, L, T, H, W)
  F.DrawWidth = 2
F.forecolor = &H808080
  'bottom:
F.Line (L + F.DrawWidth, T + H + OffSet)-(L + W - F.DrawWidth, T + H + OffSet)

  'right:
F.Line (L + W + OffSet, T + F.DrawWidth)-(L + W + OffSet, T + H + OffSet - F.DrawWidth)

  F.forecolor = &HE0E0E0

  'top:
 F.Line (L - BigOffSet + F.DrawWidth, T - BigOffSet)-(L + W + BigOffSet - F.DrawWidth, T - BigOffSet)

  'left:
F.Line (L - BigOffSet, T + F.DrawWidth - BigOffSet)-(L - BigOffSet, T + H + BigOffSet - F.DrawWidth)


End Sub

Sub ReadProf ()
x = ReadFunc("ConfigName1", NameC(1))
x = ReadFunc("ConfigName2", NameC(2))
x = ReadFunc("ConfigName3", NameC(3))
x = ReadFunc("ConfigName4", NameC(4))
x = ReadFunc("ConfigName5", NameC(5))
x = ReadFunc("ConfigFile1", FileC(1))
x = ReadFunc("ConfigFile2", FileC(2))
x = ReadFunc("ConfigFile3", FileC(3))
x = ReadFunc("ConfigFile4", FileC(4))
x = ReadFunc("ConfigFile5", FileC(5))
End Sub

Sub WritProf ()
Const App = "Syswitch"
Const Ini = "SYSWITCH.INI"
x = WritePrivateProfileString(App, "ConfigFile1", FileC(1), Ini)
x = WritePrivateProfileString(App, "ConfigFile2", FileC(2), Ini)
x = WritePrivateProfileString(App, "ConfigFile3", FileC(3), Ini)
x = WritePrivateProfileString(App, "ConfigFile4", FileC(4), Ini)
x = WritePrivateProfileString(App, "ConfigFile5", FileC(5), Ini)
x = WritePrivateProfileString(App, "ConfigName1", NameC(1), Ini)
x = WritePrivateProfileString(App, "ConfigName2", NameC(2), Ini)
x = WritePrivateProfileString(App, "ConfigName3", NameC(3), Ini)
x = WritePrivateProfileString(App, "ConfigName4", NameC(4), Ini)
x = WritePrivateProfileString(App, "ConfigName5", NameC(5), Ini)
End Sub

Sub CopyFile (Source As String)
x = FALSE
If UCase$(Source) = "SYSTEM.INI" Then x = MsgBox("Restart using current SYSTEM.INI?", 4, "No Change")
If x = IDYES Then RestartProc
If x = IDNO Then Exit Sub
Destination$ = Windir + "\" + "System.ini"
DestinationBack$ = Windir + "\" + "system.bak"
Source$ = Windir + "\" + Source
On Error Resume Next
Kill DestinationBack$
Name Destination$ As DestinationBack$

Open Source$ For Binary As #1
whole = LOF(1) \ 32000

part = LOF(1) Mod 32000
If whole + part = 0 Then MsgBox Source$ + " not found.": Close : ReadProf: Exit Sub
buffer$ = String$(32000, 0)
start& = 1
Open Destination$ For Binary As #2
On Error GoTo ErrProc
For x = 1 To whole
       Get #1, start&, buffer$
       Put #2, start&, buffer$
       start& = start& + 32000
Next x
buffer$ = String$(part, 0)
Get #1, start&, buffer$
Put #2, start&, buffer$
Close
Call RestartProc
Exit Sub


ErrProc:
MsgBox "Disk error"
Kill Destination$
Name DestinationBack$ As Destination$
End
End Sub

Sub RestartProc ()
Okay% = ExitWindows(&H42, 0)
If Okay% = 0 Then MsgBox "Cannot Restart Windows", 32, "Win Restart"
End
End Sub

Function ReadFunc (Desire$, Destination$)
Default$ = "Default Configuration"
If Mid$(Desire$, 7, 1) = "F" Then Default$ = "SYSTEM.INI"
RLen = GetPrivateProfileString("Syswitch", Desire$, Default$, ReadString, 128, "Syswitch.INI")
Destination$ = Left$(ReadString, RLen)
End Function

Function GetHighLight () As Integer
For I = 0 To 4
If Form1.Option1(I).Value = TRUE Then GetHighLight = I
Next I
End Function

Sub Openfile (C As Control)
   WorkingFileName = Windir + "\SYS2.TXT"
    OpenMode% = READFILE
   FileNum% = Fileopener(WorkingFileName, OpenMode%, 0)
   If FileNum% = 0 Then GoTo OpenErr
  On Error GoTo OpenErr
  If LOF(FileNum%) > 60000 Then
    Msg$ = "Sorry your file is too large to edit."
    MsgBox Msg$, 16, "File Too Big"
    Exit Sub
  End If
  Do Until EOF(FileNum%)
  Line Input #FileNum%, NextLine$
    LineFromFile$ = LineFromFile$ + NextLine$ + Chr$(13) + Chr$(10)
  Loop
C.Text = LineFromFile$
Close FileNum%
Exit Sub

OpenErr:
MsgBox "Problem reading " + WorkingFileName
C.Text = "Couldn't read instructions file"
Exit Sub

End Sub

Function Fileopener (NameToUse$, Mode%, RecordLen%) As Integer
  Const READFILE = 2
  FileNum% = FreeFile
  On Error GoTo OpenerError
  Open NameToUse For Input As FileNum%
  Fileopener = FileNum%
 Exit Function

OpenerError:
FileOpner = 0
Exit Function
End Function

Sub CommandTest ()
    Com$ = Command$
    If Com$ = "" Then Exit Sub
DirCheck:
    Slash = InStr(Com$, "\")
    If Slash = 0 Then GoTo DirGone
    If Slash = Len(Com$) Then GoTo CommandError
    Com$ = Mid$(Com$, Slash + 1)
    GoTo DirCheck
DirGone:
    If Com$ = "" Then Exit Sub
    If Len(Com$) > 12 Then GoTo CommandError
    Period = InStr(Com$, ".")
    If Period < 1 Or Period > 9 Then GoTo CommandError
    If Len(Mid$(Com$, Period + 1)) > 3 Then GoTo CommandError
    CopyFile (Com$)
    Exit Sub
CommandError:
MsgBox Command$ + " is not a legal file name."
Exit Sub
End Sub